home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / cfftf1.f < prev    next >
Text File  |  1989-08-14  |  2KB  |  68 lines
  1. *deck cfftf1
  2.       subroutine cfftf1 (n,c,ch,wa,ifac)
  3. C***BEGIN PROLOGUE  CFFTF1
  4. C***REFER TO CFFTF
  5. C***ROUTINES CALLED  PASSF,PASSF5,PASSF3,PASSF2,PASSF4
  6. C***END PROLOGUE  CFFTF1
  7.       dimension       ch(1)      ,c(1)       ,wa(1)      ,ifac(1)
  8. C***FIRST EXECUTABLE STATEMENT  CFFTF1
  9.       nf = ifac(2)
  10.       na = 0
  11.       l1 = 1
  12.       iw = 1
  13.       do 116 k1=1,nf
  14.          ip = ifac(k1+2)
  15.          l2 = ip*l1
  16.          ido = n/l2
  17.          idot = ido+ido
  18.          idl1 = idot*l1
  19.          if (ip .ne. 4) go to 103
  20.          ix2 = iw+idot
  21.          ix3 = ix2+idot
  22.          if (na .ne. 0) go to 101
  23.          call passf4 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3))
  24.          go to 102
  25.   101    call passf4 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3))
  26.   102    na = 1-na
  27.          go to 115
  28.   103    if (ip .ne. 2) go to 106
  29.          if (na .ne. 0) go to 104
  30.          call passf2 (idot,l1,c,ch,wa(iw))
  31.          go to 105
  32.   104    call passf2 (idot,l1,ch,c,wa(iw))
  33.   105    na = 1-na
  34.          go to 115
  35.   106    if (ip .ne. 3) go to 109
  36.          ix2 = iw+idot
  37.          if (na .ne. 0) go to 107
  38.          call passf3 (idot,l1,c,ch,wa(iw),wa(ix2))
  39.          go to 108
  40.   107    call passf3 (idot,l1,ch,c,wa(iw),wa(ix2))
  41.   108    na = 1-na
  42.          go to 115
  43.   109    if (ip .ne. 5) go to 112
  44.          ix2 = iw+idot
  45.          ix3 = ix2+idot
  46.          ix4 = ix3+idot
  47.          if (na .ne. 0) go to 110
  48.          call passf5 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3),wa(ix4))
  49.          go to 111
  50.   110    call passf5 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3),wa(ix4))
  51.   111    na = 1-na
  52.          go to 115
  53.   112    if (na .ne. 0) go to 113
  54.          call passf (nac,idot,ip,l1,idl1,c,c,c,ch,ch,wa(iw))
  55.          go to 114
  56.   113    call passf (nac,idot,ip,l1,idl1,ch,ch,ch,c,c,wa(iw))
  57.   114    if (nac .ne. 0) na = 1-na
  58.   115    l1 = l2
  59.          iw = iw+(ip-1)*idot
  60.   116 continue
  61.       if (na .eq. 0) return
  62.       n2 = n+n
  63.       do 117 i=1,n2
  64.          c(i) = ch(i)
  65.   117 continue
  66.       return
  67.       end
  68.